home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / mac / utils.el < prev    next >
Encoding:
Text File  |  1994-03-09  |  1.9 KB  |  67 lines  |  [TEXT/EMAC]

  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993, 1994 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  7. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  8. ;;; GNU General Public License for more details.
  9. ;;;
  10.  
  11. (defun bring-emacs-to-the-front ()
  12.   (let ((us (make-string (c:sizeof 'ProcessSerialNumber) 0)))
  13.     (c:slotset 'ProcessSerialNumber us 'highLongOfPSN 0)
  14.     (c:slotset 'ProcessSerialNumber us 'lowLongOfPSN kCurrentProcess)
  15.     (SetFrontProcess us)))
  16.  
  17. (defun hex-string-to-int (string)
  18.   (cond
  19.    ((numberp string)
  20.     string)
  21.    ((zerop (length string))
  22.     0)
  23.    (t
  24.     (let* ((c (string-to-char (substring string -1)))
  25.            (place (cond
  26.                    ((and (>= c (string-to-char "0")) (<= c (string-to-char "9")))
  27.                     (- c (string-to-char "0")))
  28.                    ((and (>= c (string-to-char "a")) (<= c (string-to-char "f")))
  29.                     (+ 10 (- c (string-to-char "a"))))
  30.                    ((and (>= c (string-to-char "A")) (<= c (string-to-char "F")))
  31.                     (+ 10 (- c (string-to-char "A"))))
  32.                    (t
  33.                     0))))
  34.       (+ place (* 16 (hex-string-to-int (substring string 0 -1))))))))
  35.  
  36. (defun encode-long-integer (i)
  37.   (let ((s (make-string 4 0)))
  38.     (encode-internal s 0 'long i)
  39.     s))
  40.  
  41. (defun PtoCstr (s)
  42.   (let* ((n (extract-internal s 0 'unsigned-char)))
  43.     (substring s 1 (1+ n))))
  44.  
  45. (defun CtoPstr (s)
  46.   (let* ((n (length s))
  47.          (m (if (> n 255) 255 n))
  48.          (u (concat " " s)))
  49.     (encode-internal u 0 'char m)
  50.     u))
  51.  
  52. (defun nmapcar (f &rest x)
  53.   (if (null (car x))
  54.       nil
  55.     (cons (apply f (mapcar 'car x))
  56.           (apply 'nmapcar f (mapcar 'cdr x)))))
  57.  
  58. (defun make-rgb (r g b)
  59.   (let ((s (make-string (c:sizeof 'RGBColor) 0)))
  60.     (c:slotset 'RGBColor s 'red r)
  61.     (c:slotset 'RGBColor s 'green g)
  62.     (c:slotset 'RGBColor s 'blue b)
  63.     s))
  64.  
  65. (defun make-rect ()
  66.   (make-string (c:sizeof 'Rect) 0))
  67.